home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / f77.lzh / F77.C next >
Encoding:
C/C++ Source or Header  |  1992-01-23  |  8.4 KB  |  248 lines
  1. /* Compiler-Driver for BC-Fortran-77
  2.  *
  3.  * (C)1992, Ulf Bartelt
  4.  *
  5.  * History (youngest first):
  6.  *
  7.  * 920122 - started in Sozobon-C 2.0
  8.  * 920123 - Option -n ans some bugfixes
  9.  *        - Dgetdrv/Dsetdrv used additionally to chdir()...
  10.  */
  11.  
  12.  
  13. #include <stdio.h>
  14. #include <string.h>
  15. #include <ctype.h>
  16. #include <osbind.h>
  17.  
  18.  
  19. extern char *getenv();
  20.  
  21.  
  22. void usage()
  23. {  fputs("BC-FORTRAN-77 Driver V.0.12, (C)1992 by Ulf Bartelt\n",stderr);
  24.    fputs("    -c   compile only\n",stderr);
  25.    fputs("    -f   no casefolding, distinguish upper and lowercase\n",stderr);
  26.    fputs("    -g   compile with debug code\n",stderr);
  27.    fputs("    -n   no actions, only show commands...\n",stderr);
  28.    fputs("    -O   optimize (currently only optimizes linking)\n",stderr);
  29.    fputs("    -r   don't link with MATHLIB.B\n",stderr);
  30.    fputs("    -sn  set stack size to n kBytes\n",stderr);
  31.    fputs("    -v   verbose compile and link\n",stderr);
  32.    fputs("    -vc  verbose compile\n",stderr);
  33.    fputs("    -vl  verbose link\n",stderr);
  34.    exit(0);
  35. }
  36.  
  37.  
  38. char filetype( file )
  39.    char *file;
  40. {  register char *cp=file, *lb, *lp;
  41.    while( *cp )
  42.       if(      *cp == '\\' ) lb=cp++;
  43.       else if( *cp == '.' ) lp=cp++;
  44.       else cp++;
  45.    if( lb < lp && lp[2] == 0 )
  46.       switch( toupper(lp[1]) )
  47.       {  case 'F' : return 'F';
  48.          case 'B' : return 'B';
  49.       }
  50.    return 0;
  51. }
  52.  
  53.  
  54. char *f_2_b( file )           /* a legal source file name is assumend !!! */
  55.    char *file;                /* i.e.:    <drive:\path\name>.f            */
  56. {  register char *cp = file;
  57.    register char *lp; /* last (p)oint */
  58.    while( *cp ) if( *cp == '.'  ) lp=cp++; else cp++;
  59.    lp[1] = 'b';
  60.    return file;
  61. }
  62.  
  63.  
  64. int main( argc, argv )
  65.    int argc;
  66.    char *argv[];
  67. {
  68.    int retcode = 0;
  69.  
  70.    char bcf_opts[40];
  71.    char bcl_opts[40];
  72.    char bcf_files[129];
  73.    char bcl_files[129];
  74.    char bcf_exec[129];
  75.    char bcl_exec[129];
  76.  
  77.    char stacksize[21];
  78.  
  79.    struct {
  80.       unsigned c_casefold:1;  /* -f        ==> -U for compiler  */
  81.       unsigned c_debug:1;     /* -g        ==> -D for compiler  */
  82.       unsigned c_verbose:1;   /* -v or -vc ==> -L for compiler  */
  83.       unsigned l_mathlib:1;   /* -r                             */
  84.       unsigned l_optimize:1;  /* -O        ==> -O for linker    */
  85.       unsigned l_stacksize:1; /* -s<n>     ==> -S<n> for linker */
  86.       unsigned l_verbose:1;   /* -v or -vl ==> -L for linker    */
  87.       unsigned x_nolink:1;    /* -c                             */
  88.       unsigned x_donothing:1; /* -n                             */
  89.       unsigned got_f_files:1; /* *.f files in arglist           */
  90.       unsigned got_b_files:1; /* *.b files in arglist           */
  91.    } flags;
  92.  
  93.    flags.c_casefold  = 1;
  94.    flags.c_debug     = 0;
  95.    flags.c_verbose   = 0;
  96.    flags.got_b_files = 0;
  97.    flags.got_f_files = 0;
  98.    flags.l_mathlib   = 1;
  99.    flags.l_optimize  = 0;
  100.    flags.l_stacksize = 0;
  101.    flags.l_verbose   = 0;
  102.    flags.x_nolink    = 0;
  103.    flags.x_donothing = 0;
  104.  
  105.    strcpy(bcf_files,"");
  106.    strcpy(bcl_files,"");
  107.  
  108.    {  int i=1;
  109.       char *file[129];
  110.  
  111.       while( i<argc )
  112.       {  if( argv[i][0]=='-' )                         /* collect options */
  113.          {  switch( argv[i][1] )
  114.             {
  115.                case '?': /* help */
  116.                case 'h': usage();
  117.                          /* "break"ed by exit in usage() */
  118.                case 'c': flags.x_nolink = 1;
  119.                          break;
  120.                case 'f': flags.c_casefold = 0;
  121.                          break;
  122.                case 'g': /* debug */
  123.                          flags.c_debug = 1;
  124.                          break;
  125.                case 'n': flags.x_donothing = 1;
  126.                          break;
  127.                case 'O': /* optimizing link */
  128.                          flags.l_optimize = 1;
  129.                          break;
  130.                case 'r': flags.l_mathlib = 0;
  131.                          break;
  132.                case 's': flags.l_stacksize = 1;
  133.                          strcpy(stacksize,argv[i]);
  134.                          strcat(stacksize," ");
  135.                          stacksize[1]='S'; /* BCL wants "S" */
  136.                          break;
  137.                case 'v': /* verbose */
  138.                          switch( argv[i][2] )
  139.                          {  case 000: flags.l_verbose = 1;
  140.                             case 'c': flags.c_verbose = 1; break;
  141.                             case 'l': flags.l_verbose = 1; break;
  142.                             default : fprintf(stderr,"unknown option \"%s\"...\n",argv[i]);
  143.                                       exit(1);
  144.                          }
  145.                          break;
  146.                default : /* option error */
  147.                          fprintf("unknown option \"%s\"...\n",argv[i]);
  148.                          exit(1);
  149.             }
  150.          }
  151.          else /*if( argv[i][0]!='-' )*/                  /* collect files */
  152.          {  if( fullpath(file,argv[i]) )
  153.             {
  154.                switch( filetype(file) )
  155.                {  case 'F': flags.got_f_files = 1;
  156.                             strcat(bcf_files,file);
  157.                             strcat(bcf_files," ");
  158.                             strcat(bcl_files,f_2_b(file));
  159.                             strcat(bcl_files," ");
  160.                             break;
  161.                   case 'B': flags.got_b_files = 1;
  162.                             strcat(bcl_files,file);
  163.                             strcat(bcl_files," ");
  164.                             break;
  165.                   default : fprintf(stderr,"Illegal suffix: %s\n",file);
  166.                             exit(1);
  167.                }
  168.             }
  169.          }
  170.          ++i;
  171.       }
  172.    }
  173.  
  174.    if( flags.got_f_files && flags.got_b_files )
  175.    {  fputs("can't mix operations on *.f and *.b...\n",stderr);
  176.       exit(1);
  177.    }
  178.  
  179.    strcpy(bcf_opts,"");
  180.    strcpy(bcl_opts,"");
  181.    if( flags.c_debug     ) strcat(bcf_opts,"-D ");
  182.    if( flags.c_verbose   ) strcat(bcf_opts,"-P ");
  183.    if( flags.c_casefold  ) strcat(bcf_opts,"-U ");
  184.  
  185.    if( flags.l_optimize  ) strcat(bcl_opts,"-O ");
  186.    if( flags.l_verbose   ) strcat(bcl_opts,"-P ");
  187.    if( flags.l_stacksize ) strcat(bcl_opts,stacksize);
  188.  
  189.    if( flags.l_mathlib  ) strcat(bcl_files,"mathlib.b");
  190.  
  191.    if( flags.got_f_files )
  192.    {  char *execpath, *cp, command[129];
  193.       execpath = getenv("BCF_EXEC"); /* if NULL, pfindfile uses $PATH */
  194.       cp = pfindfile(execpath,"BCF.TTP");
  195.       if( !cp ) { fputs("compiler not found.\n",stderr); exit(1); }
  196.       else strcpy(bcf_exec,cp);
  197.  
  198.       sprintf(command,"%s %s%s",bcf_exec,bcf_opts,bcf_files);
  199.       if( flags.c_verbose || flags.x_donothing ) puts(command);
  200.       if( !flags.x_donothing )
  201.       {  retcode = system(command);
  202.          if( retcode ) { fputs("compiler failed !\n",stderr); exit(retcode); }
  203.          /* Das funktioniert leider nicht...
  204.           * Der Code bleibt aber trotzdem drin !
  205.           */
  206.       }
  207.    }
  208.  
  209.    if( (flags.got_f_files && !flags.x_nolink) || flags.got_b_files )
  210.    {  char *execpath, *libpath, *cp, drive = Dgetdrv(), libdrv;
  211.       char cwd[129],command[129];
  212.  
  213.       execpath = getenv("BCF_EXEC"); /* if NULL, pfindfile uses $PATH */
  214.       cp = pfindfile(execpath,"BCL.TTP");
  215.       if( !cp ) { fputs("linker not found.\n",stderr); exit(1); }
  216.       else      strcpy(bcl_exec,cp);
  217.  
  218.       if( !getcwd(cwd,128) ) { fputs("can't get cwd\n",stderr); exit(1); }
  219.  
  220.       libpath = getenv("BCF_LIB");
  221.       if( libpath )
  222.       {  if( flags.l_verbose || flags.x_donothing ) printf("cd %s\n",libpath);
  223.          libdrv = toupper(*libpath)-'A';
  224.          if( !flags.x_donothing
  225.             && (Dsetdrv(libdrv) & (1u<<libdrv))
  226.             && chdir(libpath) 
  227.            ) { fputs("can't set path to libs.\n",stderr); exit(1); }
  228.       }
  229.  
  230.       sprintf(command,"%s %s%s",bcl_exec,bcl_opts,bcl_files);
  231.       if( flags.l_verbose || flags.x_donothing ) puts(command);
  232.       if( !flags.x_donothing ) retcode = system(command);
  233.       
  234.       if( flags.l_verbose || flags.x_donothing ) printf("cd %s\n",cwd);
  235.       if( !flags.x_donothing
  236.          && (Dsetdrv(drive) & (1<<drive))
  237.          && chdir(cwd) ) { fputs("can't reset path to working directory.\n",stderr); exit(1); }
  238.  
  239.       if( !flags.x_donothing && retcode ) { fputs("linker failed !\n",stderr); exit(retcode); }
  240.       /* Das funktioniert leider nicht...
  241.        * Der Code bleibt aber trotzdem drin !
  242.        */
  243.    }
  244.  
  245.    return 0;
  246. }
  247.  
  248.